home *** CD-ROM | disk | FTP | other *** search
/ World of Education / World of Education.iso / world_s / softdb.zip / SD.PAS < prev   
Pascal/Delphi Source File  |  1993-07-02  |  46KB  |  1,374 lines
  1. {Program written by Brian Inderwies, 6/17/93}
  2. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  3.  
  4. {This program will read a user-specified number of records (maximum 50)
  5. of software titles and store them in a data file called SD.PAS.  As well,
  6. the program will be able to print records and lables}
  7. PROGRAM SOFTWARE_DATABASE;
  8.  
  9. {Initalizes the screen and printer}
  10. USES CRT, PRINTER;
  11.  
  12. {Sets constants for the file paths}
  13. CONST CONFIG_FILE = 'C:\SD\CONFIG.CFG';
  14.       MAIN_MENU_HELP = 'C:\SD\MMHELP.HLP';
  15.       CONFIG_HELP = 'C:\SD\CNHELP.HLP';
  16.       ADD_MENU_HELP = 'C:\SD\ADHELP.HLP';
  17.       PRINT_MENU_HELP = 'C:\SD\PRHELP.HLP';
  18.       DATABASE_FILE_NAME = 'C:\SD\DB.FIL';
  19.  
  20. {Sets necessary variables}
  21.  
  22.     {A character value of the user's choice at a menu}
  23. VAR CHOICE                                         : CHAR;
  24.     {A real value of a user's choice}
  25.     REAL_CHOICE                                    : REAL;
  26.     {The version number of the program, stored in CONFIG}
  27.     VERSION                                        : REAL;
  28.     {The name of the user, stored as a string in CONFIG}
  29.     REG_NAME                                       : STRING;
  30.     {A temporary storage unit used for a myriad of things}
  31.     TEMP                                           : INTEGER;
  32.     {Stores the user's preferences, read from CONFIG}
  33.     ASCII_PREF, LABEL_PREF                         : INTEGER;
  34.     {Prints out "Yes" or "No" for these options in the configuration menu}
  35.     LABELS, ASCII                                  : STRING;
  36.     {A screenful of help information}
  37.     SCREEN                                 : ARRAY [1..25] OF STRING;
  38.     {Counts lines (for help system)}
  39.     LINE                                           : INTEGER;
  40.     {Exit control variable}
  41.     EXIT                                           : INTEGER;
  42.     {The array of the database itself}
  43.     DATABASE                               : ARRAY [1..26, 1..6] OF STRING;
  44.     {The three types of files used by the program}
  45.     DB, CONFIG, HELP                               : TEXT;
  46.     {The name of the report}
  47.     DB_NAME                                        : STRING;
  48.     {Integers to control the database array}
  49.     RECORDS, FIELDS                                : INTEGER;
  50.     {The total number of records}
  51.     NUMBER_OF_RECORDS                              : INTEGER;
  52.     {Keeps track of the record number}
  53.     RECORD_NUMBER                                  : INTEGER;
  54.     {The first and last record (for printing purposes}
  55.     FIRST, LAST                                    : INTEGER;
  56.     {The number of times each label will be printed}
  57.     TIMES                                          : INTEGER;
  58.     {Keeps track (1 or 0) if the printing range has been changed}
  59.     CHANGED                                        : INTEGER;
  60.     {Control variable for input}
  61.     CONTROL                                        : INTEGER;
  62.     {"Substitiution" values for building boxes - they are replaced
  63.     with upper-ASCII or lower-ASCII codes, depending on which type
  64.     of printing has been established}
  65.     U_L_CORNER, U_R_CORNER, L_L_CORNER, L_R_CORNER : INTEGER;
  66.     D_H_LINE, D_V_LINE, SINGLE_LINE                : INTEGER;
  67.     LEFT_BREAK, RIGHT_BREAK                        : INTEGER;
  68.     UPPER_STEM, LOWER_STEM, D_U_STEM, D_L_STEM     : INTEGER;
  69.  
  70. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  71.  
  72. {Sets FORWARD values to menu procedures so that they can be called
  73. before the actual procedure exists}
  74. PROCEDURE MAIN_MENU; FORWARD;
  75. PROCEDURE CONFIGURATION;  FORWARD;
  76. PROCEDURE ADD_RECORDS;  FORWARD;
  77. PROCEDURE MODIFY_FIELD_NAMES;  FORWARD;
  78. PROCEDURE PRINT_REPORT;  FORWARD;
  79. PROCEDURE PRINT_LABELS;  FORWARD;
  80.  
  81. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  82.  
  83. {This procedure, while relatively inefficient, will draw lines consisting of
  84. higher ASCII characters.  Parameters follow the form LEFT CORNER CHARACTER,
  85. LINE CHARACTER, LENGTH OF LINE, and RIGHT CORNER character.  The left and
  86. right corner characters are skipped should their parameter values be 0}
  87. PROCEDURE ASCII_LINE(CONSOLE, L_CORNER, LINE, LINE_LENGTH, R_CORNER:INTEGER);
  88.  
  89. BEGIN;  {ASCII_LINE}
  90.  
  91.     {Draws the left corner character, if a value is specified}
  92.     IF L_CORNER > 0 THEN
  93.        {Prints to printer or screen, depending on CONSOLE}
  94.        CASE CONSOLE OF
  95.           0  : WRITE(LST, CHR(L_CORNER));
  96.           1  : WRITE(CHR(L_CORNER));
  97.          ELSE WRITE(CHR(L_CORNER));
  98.        END;  {CASE}
  99.  
  100.     {This loop will draw the specified character the number of
  101.     times as specified in LINE_LENGTH}
  102.     FOR TEMP := 1 TO LINE_LENGTH DO
  103.        {Prints to printer or screen, depending on CONSOLE}
  104.        CASE CONSOLE OF
  105.           0  : WRITE(LST, CHR(LINE));
  106.           1  : WRITE(CHR(LINE));
  107.          ELSE WRITE(CHR(LINE));
  108.        END;  {CASE}
  109.  
  110.     {Draws the right corner (or cross), if a value is specified}
  111.     IF R_CORNER > 0 THEN
  112.        {Prints to printer or screen, depending on CONSOLE}
  113.        CASE CONSOLE OF
  114.           0  : WRITE(LST, CHR(R_CORNER));
  115.           1  : WRITE(CHR(R_CORNER));
  116.          ELSE WRITE(CHR(R_CORNER));
  117.        END;  {CASE}
  118.  
  119. END;  {ASCII_LINE}
  120.  
  121. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  122.  
  123. {This procedure will print the program name and version number,
  124. as well as the defined registration name}
  125. PROCEDURE REGISTRATION_SCREEN;
  126.  
  127. BEGIN;  {REGISTRATION_SCREEN}
  128.  
  129.    {Opens CONFIG for reading, so that the version number and
  130.    registration name (among other information) can be read}
  131.    ASSIGN(CONFIG, CONFIG_FILE);
  132.    RESET(CONFIG);
  133.    READLN(CONFIG, VERSION);
  134.    READLN(CONFIG, REG_NAME);
  135.    READLN(CONFIG, DB_NAME);
  136.    READLN(CONFIG, ASCII_PREF);
  137.    READLN(CONFIG, LABEL_PREF);
  138.    {Closes CONFIG}
  139.    CLOSE(CONFIG);
  140.    WRITELN;  WRITELN;  WRITELN;
  141.    {Creates spaces}
  142.    ASCII_LINE(1, 0, 255, 21, 0);
  143.    WRITELN(CHR(254),' SOFTWARE DATABASE version ',VERSION:1:2,' ',CHR(254));
  144.    {Creates spaces}
  145.    ASCII_LINE(1, 0, 255, 23, 0);
  146.    WRITE('Registered to: ');
  147.    WRITELN(REG_NAME);
  148.    WRITELN;
  149.  
  150. END;  {REGISTRATION_SCREEN}
  151.  
  152. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  153.  
  154. PROCEDURE WELCOME;
  155.  
  156. BEGIN;  {WELCOME}
  157.  
  158.    {Clears the screen}
  159.    CLRSCR;
  160.    {Runs REGISTRATION SCREEN}
  161.    REGISTRATION_SCREEN;
  162.    {These lines write welcoming information on the screen}
  163.    WRITELN;  WRITELN;
  164.    ASCII_LINE(1, 0, 255, 24, 0);
  165.    WRITELN('Written by Brian Inderwies');
  166.    {Blank space}
  167.    ASCII_LINE(1, 0, 255, 19, 0);
  168.    WRITELN('Version 1.00 - compiled June 19, 1993');
  169.    WRITELN;
  170.    WRITELN('WELCOME!  SOFTWARE DATABASE is the  easy way  to keep  track',
  171.           ' of  all  of  your ');
  172.    WRITELN('software programs.  Fully customizable, this program allows',
  173.           ' the user to define ');
  174.    WRITELN('such parameters as memory, number of disks, platform, etc.  ',
  175.           ' Output   may   be ');
  176.    WRITELN('printed in either label or report format, and  will  consist',
  177.           ' of   higher-ASCII ');
  178.    WRITELN('characters, if the user desires. Please do not modify this ',
  179.           'program without the');
  180.    WRITELN('consent of the author. ');
  181.    {Will skip 9 lines}
  182.    FOR TEMP := 1 TO 9 DO
  183.       WRITELN;
  184.    {Blank space}
  185.    ASCII_LINE(1, 0, 255, 28, 0);
  186.    WRITELN(CHR(254),' Press RETURN ',CHR(254));
  187.    {Prompts the user to press a key}
  188.    READLN;
  189.  
  190. END;  {WELCOME}
  191.  
  192. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  193.  
  194. {This is a generic procedure which will output a given help file
  195. at a given location}
  196. PROCEDURE HELP_SCREEN(SPECIFIC_FILE:STRING; ORIGINAL_MENU:CHAR);
  197.  
  198. BEGIN;  {HELP}
  199.  
  200.    {Opens the general file HELP, whose specific file
  201.    is defined by the calling procedure}
  202.    ASSIGN(HELP, SPECIFIC_FILE);
  203.    RESET(HELP);
  204.    {Clears the screen}
  205.    CLRSCR;
  206.    {Shows the registration screen}
  207.    REGISTRATION_SCREEN;
  208.    {Reads up to 17 lines from a supplementary help file}
  209.    FOR LINE := 1 TO 17 DO
  210.  
  211.    BEGIN;   {FOR loop}
  212.  
  213.       READLN(HELP, SCREEN[LINE]);
  214.       WRITELN(SCREEN[LINE]);
  215.  
  216.    END;   {FOR loop}
  217.  
  218. WRITELN;
  219. {Creates spaces}
  220. ASCII_LINE(1, 0, 255, 28, 0);
  221. WRITELN(CHR(254),' Press RETURN ',CHR(254));
  222. READLN;
  223. {Closes file}
  224. CLOSE(HELP);
  225. {Will return to a procedure, depending on the value of ORIGINAL_MENU}
  226. CASE ORIGINAL_MENU OF
  227.    'M' : MAIN_MENU;
  228.    'C' : CONFIGURATION;
  229.    'A' : ADD_RECORDS;
  230.    'R' : PRINT_REPORT;
  231.    'L' : PRINT_LABELS;
  232. {Elsewise, the main menu will be called upon}
  233. ELSE MAIN_MENU;
  234.  
  235. END;  {CASE}
  236.  
  237. END;  {HELP_SCREEN}
  238.  
  239. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  240.  
  241. PROCEDURE PRINT_TEST;
  242.  
  243. BEGIN;   {PRINT_TEST}
  244.  
  245.    {Clears the screen}
  246.    CLRSCR;
  247.    WRITELN('Press RETURN to start the printer test...');
  248.    {Waits until RETURN is pressed}
  249.    READLN;
  250.    WRITELN;
  251.    {Prints a ASCII line to the printer}
  252.    ASCII_LINE(0, 0, 205, 40, 0);
  253.    WRITELN(LST);
  254.    WRITELN;
  255.    WRITELN('If your printer produced a straight line (see below),');
  256.    WRITELN('then you can support ASCII printing:');
  257.    WRITELN;
  258.    {Prints a line to the screen}
  259.    ASCII_LINE(1, 0, 205, 40, 0);
  260.    WRITELN;
  261.    WRITELN;
  262.    WRITELN('Did you get a line (Y/N)?');
  263.    {Prompts the user for a choice}
  264.    CHOICE := READKEY;
  265.    {Converts CHOICE to uppercase}
  266.    CHOICE := UPCASE(CHOICE);
  267.    WRITELN(CHOICE);
  268.    CASE CHOICE OF
  269.        'Y' : ASCII_PREF := 1;
  270.        'N' : ASCII_PREF := 0;
  271.    END;  {CASE}
  272.    WRITELN;
  273.  
  274. END;  {PRINT_TEST}
  275.  
  276. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  277.  
  278. {This procedure allows the user to change the configuration}
  279. PROCEDURE CHANGE_CONFIGURATION;
  280.  
  281. BEGIN;  {CHANGE_CONFIGURATION}
  282.  
  283.     WRITELN;
  284.     WRITELN('Do you want to change the registration name (Y/N)?');
  285.     {Prompts the user}
  286.     CHOICE := READKEY;
  287.     {Sets CHOICE to uppercase}
  288.     CHOICE := UPCASE(CHOICE);
  289.     WRITELN(CHOICE);
  290.     {Will allow the user to choose a different name if desired}
  291.     IF CHOICE = 'Y'
  292.     THEN BEGIN;
  293.           WRITELN('Enter your name (15 characters maximum):');
  294.           ASCII_LINE(1, 0, 205, 15, 0);
  295.           WRITELN;
  296.           READLN(REG_NAME);
  297.          END;
  298.     WRITELN;
  299.     WRITELN('Do you want to change the database name (Y/N)?');
  300.     {Prompts the user}
  301.     CHOICE := READKEY;
  302.     {Sets CHOICE to uppercase}
  303.     CHOICE := UPCASE(CHOICE);
  304.     {Will allow the user to change his database name if desired}
  305.     WRITELN(CHOICE);
  306.     IF CHOICE = 'Y'
  307.     THEN BEGIN;
  308.             WRITELN('Enter a new database name (15 characters maximum):');
  309.             ASCII_LINE(1, 0, 205, 15, 0);
  310.             WRITELN;
  311.             {Prompts the user}
  312.             READLN(DB_NAME);
  313.          END;
  314.     WRITELN;
  315.     WRITELN('Do you want to print labels (Y/N)?');
  316.     {Prompts the user}
  317.     CHOICE := READKEY;
  318.     {Sets CHOICE to uppercase}
  319.     CHOICE := UPCASE(CHOICE);
  320.     WRITELN(CHOICE);
  321.     {Allows the user to select whether output is in reports or labels}
  322.     IF CHOICE = 'Y'
  323.        THEN LABEL_PREF := 1
  324.        ELSE LABEL_PREF := 0;
  325.     WRITELN;
  326.     WRITELN('Would you like higher-ASCII printing (see help - not all');
  327.     WRITELN('printers can support this function) (Y/N/(T)est)?');
  328.     {Prompts the user}
  329.     CHOICE := READKEY;
  330.     CHOICE := UPCASE(CHOICE);
  331.     WRITELN(CHOICE);
  332.     {Gives the user the choice of no ASCII printing, ASCII printing,
  333.     or a printer test}
  334.     CASE CHOICE OF
  335.        'Y' : ASCII_PREF := 1;
  336.        'T' : PRINT_TEST;   {calls on PRINT_TEST}
  337.        'N' : ASCII_PREF := 0;
  338.     END;
  339.     WRITELN;
  340.     WRITELN('Please wait, saving settings...');
  341.     {Writes newly created settings to file CONFIG}
  342.     REWRITE(CONFIG);
  343.     WRITELN(CONFIG, VERSION);
  344.     WRITELN(CONFIG, REG_NAME);
  345.     WRITELN(CONFIG, DB_NAME);
  346.     WRITELN(CONFIG, ASCII_PREF);
  347.     WRITELN(CONFIG, LABEL_PREF);
  348.     {Prepares the file for re-reading}
  349.     CLOSE(CONFIG);
  350.     RESET(CONFIG);
  351.     {Returns to configuration menu}
  352.  
  353.  
  354. END;  {CHANGE_CONFIGURATION}
  355.  
  356. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  357.  
  358. {This procedure will append one record to the database}
  359. PROCEDURE ADD_ONE_RECORD;
  360.  
  361. BEGIN;   {ADD_ONE_RECORD}
  362.  
  363. {Opens database for reading}
  364. RESET(DB);
  365. {Reads the number of records}
  366. READLN(DB, NUMBER_OF_RECORDS);
  367. {Reads all other database records into array DATABASE}
  368. FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 1 DO
  369.     FOR FIELDS := 1 TO 6 DO
  370.         READLN(DB, DATABASE[RECORDS, FIELDS]);
  371. {Will only let the user add a record if 25 don't
  372. already exist}
  373. IF NUMBER_OF_RECORDS < 25 THEN
  374.  
  375.    BEGIN;  {IF_THEN_LOOP}
  376.  
  377.       {Clears the screen}
  378.       CLRSCR;
  379.       WRITELN('Current number of records:  ',NUMBER_OF_RECORDS);
  380.       WRITELN('Adding record number ',NUMBER_OF_RECORDS + 1);
  381.       {Prompts the user 6 times, for the fields for which
  382.       data will be entered}
  383.       FOR FIELDS := 1 TO 6 DO
  384.  
  385.       BEGIN;   {FOR loop}
  386.  
  387.          WRITELN;
  388.          WRITELN('Please enter a value for field ',DATABASE[1, FIELDS],
  389.          ' (19 characters maximum):');
  390.          ASCII_LINE(1, 0, 205, 20, 0);
  391.          WRITELN;
  392.          {Prompts the user}
  393.          READLN(DATABASE[NUMBER_OF_RECORDS + 2, FIELDS]);
  394.  
  395.       END;   {FOR loop}
  396.       WRITELN;
  397.       WRITELN(CHR(254),' Press RETURN ',CHR(254));
  398.       {Requires a carriage return}
  399.       READLN;
  400.       WRITELN;
  401.       WRITELN('Please wait, saving settings...');
  402.       {Opens the database for writing}
  403.       REWRITE(DB);
  404.       {Writes all of the records (including the new one)
  405.       to the database}
  406.       WRITELN(DB, NUMBER_OF_RECORDS + 1);
  407.       FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 2 DO
  408.           FOR FIELDS := 1 TO 6 DO
  409.               WRITELN(DB, DATABASE[RECORDS, FIELDS]);
  410.    END   {IF-THEN loop}
  411.  
  412.    {If there are 25 or more records, the user will receive a message}
  413.    ELSE BEGIN;   {IF-THEN loop}
  414.  
  415.         WRITELN;
  416.         WRITELN('You have exceeded the maximum number of records.');
  417.         WRITELN('To add a new one, you must modify an existing record.');
  418.         WRITELN;
  419.         WRITELN(CHR(254),' Press RETURN ',CHR(254));
  420.         {Requires a carriage return}
  421.         READLN;
  422.  
  423.    END;  {IF-THEN loop}
  424.  
  425. {Closes the file DATABASE}
  426. CLOSE(DB);
  427. {Returns to ADD_RECORDS menu}
  428. ADD_RECORDS;
  429.  
  430. END;   {ADD_ONE_RECORD}
  431.  
  432. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  433.  
  434. {This procedure will allow the user to view one record}
  435. PROCEDURE VIEW_RECORDS;
  436.  
  437. BEGIN;   {VIEW_RECORDS}
  438.  
  439.    {Opens DATABASE for reading}
  440.    RESET(DB);
  441.    {Reads the number of records}
  442.    READLN(DB, NUMBER_OF_RECORDS);
  443.    {Will not allow you to view a record if none exist}
  444.    IF NUMBER_OF_RECORDS > 0 THEN
  445.  
  446.    BEGIN;   {IF-THEN loop}
  447.  
  448.       WRITELN;
  449.       WRITELN('There are currently ',NUMBER_OF_RECORDS,' records.');
  450.       WRITELN('Which record would you like to view (1 - ',NUMBER_OF_RECORDS,'):');
  451.       {Prompts the user for a number}
  452.       READLN(REAL_CHOICE);
  453.       {Makes the value an automatic integer}
  454.       RECORD_NUMBER := TRUNC(REAL_CHOICE);
  455.       {If the number denotes a valid record, then the record is displayed}
  456.       IF (RECORD_NUMBER <= NUMBER_OF_RECORDS) AND (RECORD_NUMBER >= 1) THEN
  457.  
  458.       BEGIN;   {nested IF-THEN loop}
  459.  
  460.          {Clears the screen}
  461.          CLRSCR;
  462.          {Reads all values up to the one requested}
  463.          FOR RECORDS := 1 TO RECORD_NUMBER + 1 DO
  464.              FOR FIELDS := 1 TO 6 DO
  465.                  READLN(DB, DATABASE[RECORDS, FIELDS]);
  466.          WRITELN('Current values for entry ',RECORD_NUMBER,':');
  467.          {Sets the number to one greater so that the correct
  468.          information is displayed}
  469.          RECORD_NUMBER := RECORD_NUMBER + 1;
  470.          WRITELN;
  471.          {Draws the information box}
  472.          ASCII_LINE(1, 218, 196, 46, 191);
  473.          WRITELN;
  474.          WRITELN(CHR(179),'  ',DATABASE[1, 1]:20,': ',DATABASE[RECORD_NUMBER, 1]:20,
  475.              '  ',CHR(179));
  476.          WRITELN(CHR(179),'  ',DATABASE[1, 2]:20,': ',DATABASE[RECORD_NUMBER, 2]:20,
  477.              '  ',CHR(179));
  478.          WRITELN(CHR(179),'  ',DATABASE[1, 3]:20,': ',DATABASE[RECORD_NUMBER, 3]:20,
  479.              '  ',CHR(179));
  480.          WRITELN(CHR(179),'  ',DATABASE[1, 4]:20,': ',DATABASE[RECORD_NUMBER, 4]:20,
  481.                 '  ',CHR(179));
  482.          WRITELN(CHR(179),'  ',DATABASE[1, 5]:20,': ',DATABASE[RECORD_NUMBER, 5]:20,
  483.                  '  ',CHR(179));
  484.          WRITELN(CHR(179),'  ',DATABASE[1, 6]:20,': ',DATABASE[RECORD_NUMBER, 6]:20,
  485.                 '  ',CHR(179));
  486.          ASCII_LINE(1, 192, 196, 46, 217);
  487.          WRITELN;   WRITELN;
  488.          WRITELN(CHR(254),' Press RETURN ',CHR(254));
  489.          {Prompts a carriage return}
  490.          READLN;
  491.  
  492.       END   {nested IF-THEN}
  493.  
  494.       {If the number is invalid, a message is printed}
  495.       ELSE BEGIN;  {nested IF-THEN}
  496.  
  497.           {Writes the message}
  498.           WRITELN('Sorry, this number is invalid because: ');
  499.           WRITELN(' ',CHR(249),' It exceeds the maximum number of entries (25), or');
  500.           WRITELN(' ',CHR(249),' There is currently no created record at that number');
  501.           WRITELN;
  502.           WRITELN(CHR(254),' Press RETURN ',CHR(254));
  503.           {Prompts a carriage return}
  504.           READLN;
  505.  
  506.       END;  {nested IF-THEN}
  507.  
  508.    END  {IF-THEN loop}
  509.  
  510.    {If no records exist, a message will be printed}
  511.    ELSE BEGIN;   {IF-THEN loop}
  512.  
  513.          WRITELN;
  514.          WRITELN('Sorry, there are currently no records to view.');
  515.          WRITELN;  WRITELN(CHR(254),' Press RETURN ',CHR(254));
  516.          {Prompts a carriage return}
  517.          READLN;
  518.  
  519.       END;  {IF-THEN loop}
  520.  
  521. {Closes the DATABASE file}
  522. CLOSE(DB);
  523. {Returns to ADD_RECORDS menu}
  524. ADD_RECORDS;
  525.  
  526. END;   {VIEW_RECORDS}
  527.  
  528. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  529.  
  530. {This procedure will modify the record of the user's choice}
  531. PROCEDURE MODIFY_RECORDS;
  532.  
  533. BEGIN;  {MODIFY_RECORDS}
  534.  
  535.    {Opens the database for reading}
  536.    RESET(DB);
  537.    {Reads the number of records existing}
  538.    READLN(DB, NUMBER_OF_RECORDS);
  539.    {Will only allow the modification of a record if one exists}
  540.    IF NUMBER_OF_RECORDS >= 1 THEN
  541.  
  542.    BEGIN;  {IF-THEN loop}
  543.  
  544.       {Reads all records into array DATABASE}
  545.       FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 1 DO
  546.           FOR FIELDS := 1 TO 6 DO
  547.               READLN(DB, DATABASE[RECORDS, FIELDS]);
  548.       WRITELN;
  549.       WRITELN('There are currently ',NUMBER_OF_RECORDS,' record(s).');
  550.       WRITELN('Which would you like to modify (1 - ',NUMBER_OF_RECORDS,')?');
  551.       {Reads the record number}
  552.       READLN(REAL_CHOICE);
  553.       {Forces the number as an integer}
  554.       RECORD_NUMBER := TRUNC(REAL_CHOICE);
  555.       {Will modify the record if the inputted choice is valid}
  556.       IF (RECORD_NUMBER > 0) AND (RECORD_NUMBER <= NUMBER_OF_RECORDS) THEN
  557.  
  558.       BEGIN;   {nested IF-THEN}
  559.  
  560.          {Clears the screen}
  561.          CLRSCR;
  562.          WRITELN('Modifying entry ',RECORD_NUMBER,'...');
  563.          {Modifies each record for all fields (6)}
  564.          FOR CONTROL := 1 TO 6 DO
  565.  
  566.          BEGIN;  {FOR loop}
  567.  
  568.             WRITELN;
  569.             WRITELN('Current value of this entry: ',DATABASE[RECORD_NUMBER + 1, CONTROL]);
  570.             WRITELN('Please enter a value for field ',DATABASE[1, CONTROL],
  571.             ' (19 characters maximum):');
  572.             ASCII_LINE(1, 0, 205, 20, 0);
  573.             WRITELN;
  574.             {Reads the value as part of the array}
  575.             READLN(DATABASE[RECORD_NUMBER + 1, CONTROL]);
  576.  
  577.          END;    {FOR loop}
  578.  
  579.          WRITELN;
  580.          WRITELN('Are you sure that you want to modify this entry (Y/N)?');
  581.          {Reads the character as a key}
  582.          CHOICE := READKEY;
  583.          {Converts the value to uppercase}
  584.          CHOICE := UPCASE(CHOICE);
  585.          {Writes the inputted value to the screen}
  586.          WRITELN(CHOICE);
  587.          {Will write the change if Y is selected}
  588.          IF CHOICE = 'Y' THEN
  589.  
  590.          BEGIN;  {double-nested IF-THEN}
  591.  
  592.            WRITELN;  WRITELN('Please wait, saving settings...');
  593.            {Opens the database for writing}
  594.            REWRITE(DB);
  595.            {Writes the array and number of records to the file}
  596.            WRITELN(DB, NUMBER_OF_RECORDS);
  597.            FOR RECORDS := 1 TO RECORD_NUMBER DO
  598.              FOR FIELDS := 1 TO 6 DO
  599.                  WRITELN(DB, DATABASE[RECORDS, FIELDS]);
  600.            FOR CONTROL := 1 TO 6 DO
  601.              WRITELN(DB, DATABASE[RECORD_NUMBER + 1, CONTROL]);
  602.            FOR RECORDS := RECORD_NUMBER + 2 TO NUMBER_OF_RECORDS + 1 DO
  603.              FOR FIELDS := 1 TO 6 DO
  604.                  WRITELN(DB, DATABASE[RECORDS, FIELDS]);
  605.            {Closes DATABASE}
  606.            CLOSE(DB);
  607.  
  608.          END;  {double-nested IF-THEN}
  609.  
  610.       END   {nested IF-THEN}
  611.  
  612.    END  {IF-THEN loop}
  613.  
  614.    {If there are no records, a message is printed}
  615.    ELSE BEGIN;   {IF-THEN loop}
  616.  
  617.       WRITELN;
  618.       WRITELN('Sorry, there are currently no records to modify.');
  619.       WRITELN;
  620.       WRITELN(CHR(254),' Press RETURN ',CHR(254));
  621.       {Prompts a carriage return}
  622.       READLN;
  623.  
  624.    END;   {IF-THEN loop}
  625.  
  626. {Calls on ADD_RECORDS menu}
  627. ADD_RECORDS;
  628.  
  629. END;   {MODIFY_RECORDS}
  630.  
  631. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  632.  
  633. {This procedure will quit the program by changing the value of the exit
  634. "flag" (stored in variable EXIT)}
  635. PROCEDURE QUIT;
  636.  
  637. BEGIN;  {QUIT}
  638.  
  639.    {Initally sets the quit variable, CHOICE, to NO}
  640.    CHOICE := 'N';
  641.    WRITELN;
  642.    WRITELN('Are you sure (Y/N)?');
  643.    {Reads the user's input, YES or NO}
  644.    CHOICE := READKEY;
  645.    {Converts the CHOICE var. so that it is always uppercase}
  646.    CHOICE := UPCASE(CHOICE);
  647.    WRITELN(CHOICE);
  648.    {If the user doesn't want to quit, the main menu is returned to.
  649.    If he does, then EXIT is 1 and the program will stop}
  650.    IF CHOICE <> 'Y' THEN EXIT := 1
  651.                     ELSE EXIT := 0;
  652.  
  653. END;  {QUIT}
  654.  
  655. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  656.  
  657. {This procedure will truncate the last record in the database}
  658. PROCEDURE TRUNCATE_LAST;
  659.  
  660. BEGIN;  {TRUNCATE_LAST}
  661.  
  662.    {Opens the database for reading}
  663.    RESET(DB);
  664.    READLN(DB, NUMBER_OF_RECORDS);
  665.    {If records exist, the option will be given}
  666.    IF NUMBER_OF_RECORDS >= 1 THEN
  667.  
  668.    BEGIN;  {IF-THEN loop}
  669.  
  670.      FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 1 DO
  671.        FOR FIELDS := 1 TO 6 DO
  672.          READLN(DB, DATABASE[RECORDS, FIELDS]);
  673.      WRITELN;  WRITELN('There are currently ',NUMBER_OF_RECORDS,' records.');
  674.      WRITELN('Do you REALLY want to delete record ',NUMBER_OF_RECORDS,' (Y/N)?');
  675.      {Prompts the user for a character response}
  676.      CHOICE := READKEY;
  677.      {Converts that choice to uppercase}
  678.      CHOICE := UPCASE(CHOICE);
  679.      {Writes it back to the screen}
  680.      WRITELN(CHOICE);
  681.      {Will delete record if choice was Y}
  682.      IF CHOICE = 'Y' THEN
  683.  
  684.      BEGIN;    {nested IF-THEN}
  685.  
  686.       WRITELN;  WRITELN('Truncating entry ',NUMBER_OF_RECORDS,'...');
  687.       {Truncates the last by shortening the number of records}
  688.       NUMBER_OF_RECORDS := NUMBER_OF_RECORDS - 1;
  689.       {Opens file for writing}
  690.       REWRITE(DB);
  691.       {Re-writes entire database information back to the file}
  692.       WRITELN(DB, NUMBER_OF_RECORDS);
  693.       FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 1 DO
  694.           FOR FIELDS := 1 TO 6 DO
  695.               WRITELN(DB, DATABASE[RECORDS, FIELDS]);
  696.       {Closes the file DATABASE}
  697.       CLOSE(DB);
  698.  
  699.      END;  {nested IF-THEN}
  700.  
  701. END   {IF-THEN loop}
  702.  
  703. {If no files exist, a message will be printed}
  704. ELSE BEGIN;  {IF-THEN loop}
  705.  
  706.    WRITELN;
  707.    WRITELN('There are no records to delete.');
  708.    WRITELN;  WRITELN(CHR(254),' Press RETURN ',CHR(254));
  709.    {Prompts a carriage return}
  710.    READLN;
  711.  
  712. END;  {IF-THEN loop}
  713.  
  714. {Returns to ADD_RECORDS menu}
  715. ADD_RECORDS;
  716.  
  717. END;   {TRUNCATE_LAST}
  718.  
  719. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  720.  
  721. {This procedure will access the ADD RECORDS menu}
  722. PROCEDURE ADD_RECORDS;
  723.  
  724. BEGIN;  {ADD_RECORDS}
  725.  
  726.    {Assigns DATABASE to a DOS file name}
  727.    ASSIGN(DB, DATABASE_FILE_NAME);
  728.    {Clears the screen}
  729.    CLRSCR;
  730.    {Runs REGISTRATION SCREEN}
  731.    REGISTRATION_SCREEN;
  732.    {These next few lines draw the menu itself}
  733.    WRITELN;
  734.    ASCII_LINE(1, 0, 255, 16, 0);
  735.    WRITELN(CHR(240),' ADD RECORDS ',CHR(240));
  736.    WRITELN;
  737.    ASCII_LINE(1, 218, 196, 43, 191);
  738.    WRITELN;
  739.    WRITELN(CHR(179),' [A]dd a record                            ',CHR(179));
  740.    WRITELN(CHR(179),' [V]iew a record                           ',CHR(179));
  741.    WRITELN(CHR(179),' [M]odify a record                         ',CHR(179));
  742.    WRITELN(CHR(179),' [T]runcate last record                    ',CHR(179));
  743.    WRITELN(CHR(179),' [E]xit program                            ',CHR(179));
  744.    WRITELN(CHR(179),' [Q]uit to main                            ',CHR(179));
  745.    WRITELN(CHR(179),' [?] Help                                  ',CHR(179));
  746.    ASCII_LINE(1, 192, 196, 43, 217);
  747.    WRITELN;
  748.    WRITELN;
  749.    {Asks the user to press a desired key, to be stored in CHOICE}
  750.    CHOICE := READKEY;
  751.    {Keeps CHOICE an uppercase character}
  752.    CHOICE := UPCASE(CHOICE);
  753.    {Writes CHOICE back to the screen}
  754.    WRITELN(CHOICE);
  755.    {Runs the respective procedure, depending on the value of CHOICE}
  756.    CASE CHOICE OF
  757.      'A'           : ADD_ONE_RECORD;
  758.      'V'           : VIEW_RECORDS;
  759.      'M'           : MODIFY_RECORDS;
  760.      'E'           : QUIT;
  761.      'T'           : TRUNCATE_LAST;
  762.      'Q'           : MAIN_MENU;
  763.      '?'           : HELP_SCREEN(ADD_MENU_HELP,'A');
  764.    {Else, the menu will be redrawn}
  765.    ELSE ADD_RECORDS;
  766.    END;  {CASE}
  767.  
  768. END;  {ADD_RECORDS}
  769.  
  770. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  771.  
  772. {This procedure will physically change the name of a field}
  773. PROCEDURE CHANGE_NAME(FIELD_NUMBER:INTEGER);
  774.  
  775. BEGIN;  {CHANGE_NAME}
  776.  
  777.    WRITELN;
  778.    WRITELN('Current name is: ',DATABASE[1, FIELD_NUMBER]:20);
  779.    WRITELN('Enter new name (18 characters maximum): ');
  780.    ASCII_LINE(1, 0, 205, 15, 0);
  781.    WRITELN;
  782.    {Reads a string, which will be a field name}
  783.    READLN(DATABASE[1, FIELD_NUMBER]);
  784.    {Opens the database for reading}
  785.    REWRITE(DB);
  786.    WRITELN(DB, NUMBER_OF_RECORDS);
  787.    {Rewrites all of the names}
  788.    FOR TEMP := 1 TO 6 DO
  789.        WRITELN(DB, DATABASE[1, TEMP]);
  790.  
  791. {Writes the rest of the records}
  792. FOR RECORDS := 2 TO (NUMBER_OF_RECORDS + 1) DO
  793.        FOR FIELDS := 1 TO 6 DO
  794.            WRITELN(DB, DATABASE[RECORDS, FIELDS]);
  795.  
  796. {Closes database file}
  797. CLOSE(DB);
  798.  
  799. END;  {CHANGE_NAME}
  800.  
  801. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  802.  
  803. {This procedure will allow the user to modify the field names
  804. (6 in all)}
  805. PROCEDURE MODIFY_FIELD_NAMES;
  806.  
  807. BEGIN;  {MODIFY_FIELD_NAMES}
  808.  
  809.    {Assigns the database to its respective path}
  810.    ASSIGN(DB, DATABASE_FILE_NAME);
  811.    RESET(DB);
  812.    READLN(DB, NUMBER_OF_RECORDS);
  813.    FOR TEMP := 1 TO 6 DO
  814.    READLN(DB, DATABASE[1, TEMP]);
  815.    FOR RECORDS := 2 TO (NUMBER_OF_RECORDS + 1) DO
  816.        FOR FIELDS := 1 TO 6 DO
  817.            READLN(DB, DATABASE[RECORDS, FIELDS]);
  818.    CLRSCR;
  819.    {These next (many) lines do nothing more than print a
  820.    chart of the current field names}
  821.    ASCII_LINE(1, 0, 178, 78, 0);
  822.    WRITELN;
  823.    ASCII_LINE(1, 0, 178, 28, 0);
  824.    WRITE(' CURRENT FIELD NAMES ');
  825.    ASCII_LINE(1, 0, 178, 29, 0);
  826.    WRITELN;
  827.    ASCII_LINE(1, 0, 177, 78, 0);
  828.    WRITELN;
  829.    ASCII_LINE(1, 0, 177, 8, 0);
  830.    WRITE(' ',DATABASE[1, 1]:20,' ');
  831.    ASCII_LINE(1, 0, 177, 17, 0);
  832.    WRITE(' ',DATABASE[1, 2]:20,' ');
  833.    ASCII_LINE(1, 0, 177, 9, 0);
  834.    WRITELN;
  835.    ASCII_LINE(1, 0, 177, 8, 0);
  836.    WRITE(' ',DATABASE[1, 3]:20,' ');
  837.    ASCII_LINE(1, 0, 177, 17, 0);
  838.    WRITE(' ',DATABASE[1, 4]:20,' ');
  839.    ASCII_LINE(1, 0, 177, 9, 0);
  840.    WRITELN;
  841.    ASCII_LINE(1, 0, 176, 8, 0);
  842.    WRITE(' ',DATABASE[1, 5]:20,' ');
  843.    ASCII_LINE(1, 0, 176, 17, 0);
  844.    WRITE(' ',DATABASE[1, 6]:20,' ');
  845.    ASCII_LINE(1, 0, 176, 9, 0);
  846.    WRITELN;
  847.    ASCII_LINE(1, 0, 176, 78, 0);
  848.    WRITELN;   WRITELN;
  849.    {Prompts the user}
  850.    WRITELN('Select the field number which you would like to change ',
  851.           '(1 - 6, [Q]uit)');
  852.    {Reads CHOICE as a key}
  853.    CHOICE := READKEY;
  854.    {Will run CHANGE_NAME for the entry number provided}
  855.    CASE CHOICE OF
  856.       '1' : CHANGE_NAME(1);
  857.       '2' : CHANGE_NAME(2);
  858.       '3' : CHANGE_NAME(3);
  859.       '4' : CHANGE_NAME(4);
  860.       '5' : CHANGE_NAME(5);
  861.       '6' : CHANGE_NAME(6);
  862.       'Q' : CONFIGURATION;
  863.    {If nothing is chosen, it will return to CONFIGURATION}
  864.    ELSE CONFIGURATION;
  865.    END;  {CASE}
  866.  
  867. END;  {MODIFY_FIELD_NAMES}
  868.  
  869. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  870.  
  871. {This procedure physically prints out the report}
  872. PROCEDURE PRINT_THE_REPORT;
  873.  
  874. BEGIN;  {PRINT_THE_REPORT}
  875.  
  876. {This will modify the ASCII characters to be sent to the printer.  If
  877. upper-ASCII printing is selected, the numbers will be normal, while they
  878. will be set to standard characters if not}
  879. IF ASCII_PREF = 1 THEN
  880.  
  881.    BEGIN;  {IF-THEN loop}
  882.  
  883.          {Sets respective graphic variables}
  884.          U_L_CORNER := 201;
  885.          U_R_CORNER := 187;
  886.          L_L_CORNER := 200;
  887.          L_R_CORNER := 188;
  888.          D_H_LINE   := 205;
  889.          D_V_LINE   := 186;
  890.          SINGLE_LINE := 179;
  891.          LEFT_BREAK :=  181;
  892.          RIGHT_BREAK := 198;
  893.          UPPER_STEM :=  209;
  894.          LOWER_STEM := 207;
  895.          D_U_STEM := 203;
  896.          D_L_STEM := 202;
  897.  
  898.    END  {IF-THEN loop}
  899.  
  900.    {Sets lower-ASCII values}
  901.    ELSE BEGIN;   {IF-THEN loop}
  902.  
  903.          U_L_CORNER := 43;
  904.          U_R_CORNER := 43;
  905.          L_L_CORNER := 43;
  906.          L_R_CORNER := 43;
  907.          D_H_LINE   := 45;
  908.          D_V_LINE   := 124;
  909.          SINGLE_LINE := 124;
  910.          LEFT_BREAK := 124;
  911.          RIGHT_BREAK := 124;
  912.          UPPER_STEM := 43;
  913.          LOWER_STEM := 43;
  914.          D_U_STEM := 43;
  915.          D_L_STEM := 43;
  916.  
  917.     END;  {IF-THEN loop}
  918.  
  919.     WRITELN;
  920.     WRITELN('Make SURE that your printer is on...');
  921.     WRITELN;  WRITELN(CHR(254),' Press RETURN ',CHR(254));
  922.     {Prompts a carriage return}
  923.     READLN;
  924.     WRITELN('Printing, please wait.....');
  925.     {Opens the database for reading}
  926.     ASSIGN(DB, DATABASE_FILE_NAME);
  927.     RESET(DB);
  928.     {Reads only records that were specified by the user}
  929.     READLN(DB, NUMBER_OF_RECORDS);
  930.     FOR RECORDS := 1 TO (LAST + 1) DO
  931.           FOR FIELDS := 1 TO 6 DO
  932.               READLN(DB, DATABASE[RECORDS, FIELDS]);
  933.     {Closes the database}
  934.     CLOSE(DB);
  935.     {Writes out heading information for the report}
  936.     WRITELN(LST,'SOFTWARE DATABASE by Brian Inderwies (Period 6), version ',
  937.            VERSION:1:2);
  938.     WRITELN(LST,'Registration Name: ',REG_NAME:15,'   Report Name: ',
  939.            DB_NAME:15);
  940.     WRITELN(LST,'Total Records: ',NUMBER_OF_RECORDS:2,'                    ',
  941.            'Printing records ',FIRST,' through ',LAST);
  942.     WRITELN(LST);
  943.     {Will print a chart of records, depending on the number existing}
  944.     FOR RECORDS := (FIRST + 1) TO (LAST + 1) DO
  945.  
  946.     BEGIN;  {FOR loop}
  947.  
  948.         {Writes top line}
  949.         ASCII_LINE(0, U_L_CORNER, D_H_LINE, 3, LEFT_BREAK);
  950.         WRITE(LST, ' ',RECORDS - 1:2,' ');
  951.         ASCII_LINE(0, RIGHT_BREAK, D_H_LINE, 9, UPPER_STEM);
  952.         ASCII_LINE(0, 0, D_H_LINE, 19, D_U_STEM);
  953.         ASCII_LINE(0, 0, D_H_LINE, 18, UPPER_STEM);
  954.         ASCII_LINE(0, 0, D_H_LINE, 19, U_R_CORNER);
  955.         WRITELN(LST);
  956.         FOR FIELDS := 1 TO 3 DO
  957.  
  958.         BEGIN;   {nested FOR loop}
  959.  
  960.               {repetitively writes entries}
  961.               WRITE(LST, CHR(D_V_LINE),DATABASE[1, FIELDS]:18);
  962.               WRITE(LST, CHR(SINGLE_LINE),DATABASE[RECORDS, FIELDS]:19);
  963.               WRITE(LST, CHR(D_V_LINE),DATABASE[1, FIELDS + 2]:18);
  964.               WRITELN(LST, CHR(SINGLE_LINE),DATABASE[RECORDS, FIELDS + 2]:19,
  965.                      CHR(D_V_LINE));
  966.  
  967.         END;   {nested FOR loop}
  968.  
  969.         {Writes bottom line}
  970.         ASCII_LINE(0, L_L_CORNER, D_H_LINE, 18, LOWER_STEM);
  971.         ASCII_LINE(0, 0, D_H_LINE, 19, D_L_STEM);
  972.         ASCII_LINE(0, 0, D_H_LINE, 18, LOWER_STEM);
  973.         ASCII_LINE(0, 0, D_H_LINE, 19, L_R_CORNER);
  974.         {Returns the cursor}
  975.         WRITELN(LST);
  976.  
  977.     END;   {FOR loop}
  978.  
  979. END;   {PRINT_THE_REPORT}
  980.  
  981. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  982.  
  983. {This procedure will physically print out labels}
  984. PROCEDURE PRINT_THE_LABELS;
  985.  
  986. BEGIN;   {PRINT_THE_LABELS}
  987.  
  988.    {Opens the database for reading}
  989.    RESET(DB);
  990.    {Reads the database in its entirety}
  991.    READLN(DB, NUMBER_OF_RECORDS);
  992.    FOR RECORDS := 1 TO NUMBER_OF_RECORDS + 1 DO
  993.           FOR FIELDS := 1 TO 6 DO
  994.               READLN(DB, DATABASE[RECORDS, FIELDS]);
  995.    {Closes the database}
  996.    CLOSE(DB);
  997.    WRITELN;
  998.    WRITELN('Make SURE that your printer is on...');
  999.    WRITELN;  WRITELN(CHR(254),' Press RETURN ',CHR(254));
  1000.    {Prompts a carriage return}
  1001.    READLN;
  1002.    WRITELN;  WRITELN('Printing, please wait.....');
  1003.    {Prints out a label for the number of iterations specified as
  1004.    well as the range of records specified}
  1005.    FOR RECORDS := (FIRST + 1) TO (LAST + 1) DO
  1006.        FOR LINE := 1 TO TIMES DO
  1007.  
  1008.            BEGIN;    {nested FOR loop}
  1009.  
  1010.               WRITE(LST, DATABASE[RECORDS, 1]:19);
  1011.               WRITELN(LST, '     Disk ',LINE:2,' of ',TIMES:2);
  1012.               WRITELN(LST,DATABASE[1, 2]:18,' ',DATABASE[RECORDS, 2]:19);
  1013.               WRITELN(LST,DATABASE[1, 3]:18,' ',DATABASE[RECORDS, 3]:19);
  1014.               WRITELN(LST,DATABASE[1, 4]:18,' ',DATABASE[RECORDS, 4]:19);
  1015.               WRITELN(LST);
  1016.               WRITELN(LST);
  1017.               WRITELN(LST);
  1018.               WRITELN(LST);
  1019.  
  1020.            END;   {nested FOR loop}
  1021.  
  1022. END;   {PRINT_THE_LABELS}
  1023.  
  1024. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1025.  
  1026. {This procedure will change the range of printing}
  1027. PROCEDURE CHANGE_RANGE;
  1028.  
  1029. BEGIN;   {CHANGE_RANGE}
  1030.  
  1031.       WRITELN;
  1032.       WRITELN('Current number of records: ',NUMBER_OF_RECORDS);
  1033.       WRITELN('Enter starting number: ');
  1034.       {Reads a user-selected number}
  1035.       READLN(REAL_CHOICE);
  1036.       {Makes value an automatic integer}
  1037.       FIRST := TRUNC(REAL_CHOICE);
  1038.       {If the number is out of range, a message will be printed}
  1039.       IF (FIRST < 1) OR (FIRST > NUMBER_OF_RECORDS) THEN
  1040.  
  1041.       BEGIN;   {IF-THEN loop}
  1042.  
  1043.          WRITELN;   WRITELN('Starting number cannot be less than 1 ',
  1044.                             'or exceed the number of existing entries.');
  1045.          WRITELN;   WRITELN(CHR(254),' Press RETURN ',CHR(254));
  1046.          {Prompts a carriage return}
  1047.          READLN;
  1048.          {Not changed if error occurs}
  1049.          CHANGED := 0;
  1050.  
  1051.       END   {IF-THEN loop}
  1052.  
  1053.       {Elsewise, the value is shown changed}
  1054.       ELSE CHANGED := 1;
  1055.       WRITELN;  WRITELN('Enter ending number: ');
  1056.       {Reads ending number}
  1057.       READLN(REAL_CHOICE);
  1058.       {Forces integer value}
  1059.       LAST := TRUNC(REAL_CHOICE);
  1060.       {If the ending number is invalid, a message is printed}
  1061.       IF (LAST > NUMBER_OF_RECORDS) OR (LAST < 1) OR (LAST < FIRST) THEN
  1062.  
  1063.       BEGIN;   {IF-THEN loop}
  1064.  
  1065.          WRITELN;   WRITELN('Ending number cannot exceed total or ',
  1066.                            'starting number, or be less than 1.');
  1067.          WRITELN;   WRITELN(CHR(254),' Press RETURN ',CHR(254));
  1068.          {Prompts a carriage return}
  1069.          READLN;
  1070.          {Unchanged value when error occurs}
  1071.          CHANGED := 0;
  1072.  
  1073.       END  {IF-THEN loop}
  1074.  
  1075.       {Elsewise, the value is known as being changed}
  1076.       ELSE CHANGED := 1;
  1077.       {If labels are being printed, then the procedure will ask
  1078.       how many times the user wants to print each label}
  1079.       IF LABEL_PREF = 1 THEN
  1080.  
  1081.       BEGIN;  {IF-THEN loop}
  1082.  
  1083.          WRITELN;
  1084.          WRITELN('How many times would you like to print each label?');
  1085.          {Reads number}
  1086.          READLN(REAL_CHOICE);
  1087.          {Only reads the value if it is valid}
  1088.          IF (REAL_CHOICE >= 1) AND (REAL_CHOICE <= 10) THEN
  1089.          BEGIN;  {nested IF-THEN}
  1090.  
  1091.             TIMES := TRUNC(REAL_CHOICE);
  1092.             CHANGED := 1;
  1093.  
  1094.          END {nested IF-THEN}
  1095.          ELSE CHANGED := 0;
  1096.  
  1097.       END;  {IF-THEN loop}
  1098.  
  1099.       {Will return to the appropriate menu, depending on what will
  1100.       be printed}
  1101.       CASE LABEL_PREF OF
  1102.         1 : PRINT_LABELS;
  1103.         0 : PRINT_REPORT;
  1104.       END;   {CASE}
  1105.  
  1106. END;   {CHANGE_RANGE}
  1107.  
  1108. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1109.  
  1110. {Produces the label-printing menu}
  1111. PROCEDURE PRINT_LABELS;
  1112.  
  1113. BEGIN;   {PRINT_LABELS}
  1114.  
  1115.    {Clears the screen}
  1116.    CLRSCR;
  1117.    {Produces registration information}
  1118.    REGISTRATION_SCREEN;
  1119.    {Opens the database for reading}
  1120.    RESET(DB);
  1121.    {Reads the number of records}
  1122.    READLN(DB, NUMBER_OF_RECORDS);
  1123.    {If the numbers were not changed, then printing defaults are instituted}
  1124.    IF CHANGED <> 1 THEN
  1125.  
  1126.    BEGIN;  {IF-THEN loop}
  1127.  
  1128.       FIRST := 1;
  1129.       LAST := NUMBER_OF_RECORDS;
  1130.       TIMES := 1;
  1131.  
  1132.    END;  {IF-THEN loop}
  1133.  
  1134.    {These next few lines draw the menu itself}
  1135.    WRITELN;
  1136.    ASCII_LINE(1, 0, 255, 14, 0);
  1137.    WRITELN(CHR(240),' PRINT: LABELS ',CHR(240));
  1138.    WRITELN;
  1139.    ASCII_LINE(1, 218, 196, 43, 191);
  1140.    WRITELN;
  1141.    WRITELN(CHR(179),' Print from records ',FIRST:2,' to ',LAST:2,'       ',
  1142.           '        ',CHR(179));
  1143.    WRITELN(CHR(179),' Print each label ',TIMES:2,' times             ',
  1144.           '    ',CHR(179));
  1145.    WRITELN(CHR(179),' [P]rint labels                            ',CHR(179));
  1146.    WRITELN(CHR(179),' [C]hange range and times                  ',CHR(179));
  1147.    WRITELN(CHR(179),' [Q]uit to main                            ',CHR(179));
  1148.    WRITELN(CHR(179),' [E]xit                                    ',CHR(179));
  1149.    WRITELN(CHR(179),' [?] Help                                  ',CHR(179));
  1150.    ASCII_LINE(1, 192, 196, 43, 217);
  1151.    WRITELN;
  1152.    WRITELN;
  1153.    {Asks the user to press a desired key, to be stored in CHOICE}
  1154.    CHOICE := READKEY;
  1155.    {Keeps CHOICE an uppercase character}
  1156.    CHOICE := UPCASE(CHOICE);
  1157.    {Runs the respective procedure, depending on the value of CHOICE}
  1158.    CASE CHOICE OF
  1159.       'P'  : PRINT_THE_LABELS;
  1160.       'C'  : CHANGE_RANGE;
  1161.       'Q'  : MAIN_MENU;
  1162.       'E'  : QUIT;
  1163.       '?'  : HELP_SCREEN(PRINT_MENU_HELP, 'L');
  1164.    {Otherwise the menu is redrawn}
  1165.    ELSE PRINT_LABELS;
  1166.    END;   {CASE}
  1167.  
  1168. END;   {PRINT_LABELS}
  1169.  
  1170. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1171.  
  1172. {This procedure will print a report}
  1173. PROCEDURE PRINT_REPORT;
  1174.  
  1175. BEGIN;  {PRINT_REPORT}
  1176.  
  1177.    {Clears the screen}
  1178.    CLRSCR;
  1179.    {Produces registration information}
  1180.    REGISTRATION_SCREEN;
  1181.    {Opens the database for reading}
  1182.    RESET(DB);
  1183.    {Reads the number of records}
  1184.    READLN(DB, NUMBER_OF_RECORDS);
  1185.    {If the numbers were not changed, then printing defaults are instituted}
  1186.    IF CHANGED <> 1 THEN
  1187.  
  1188.    BEGIN;  {IF-THEN loop}
  1189.  
  1190.       FIRST := 1;
  1191.       LAST := NUMBER_OF_RECORDS;
  1192.  
  1193.  
  1194.    END;  {IF-THEN loop}
  1195.  
  1196.    {These next few lines draw the menu itself}
  1197.    WRITELN;
  1198.    ASCII_LINE(1, 0, 255, 14, 0);
  1199.    WRITELN(CHR(240),' PRINT: REPORT ',CHR(240));
  1200.    WRITELN;
  1201.    ASCII_LINE(1, 218, 196, 43, 191);
  1202.    WRITELN;
  1203.    WRITELN(CHR(179),' Print from records ',FIRST:2,' to ',LAST:2,'       ',
  1204.           '        ',CHR(179));
  1205.    WRITELN(CHR(179),' [P]rint report                            ',CHR(179));
  1206.    WRITELN(CHR(179),' [C]hange range                            ',CHR(179));
  1207.    WRITELN(CHR(179),' [Q]uit to main                            ',CHR(179));
  1208.    WRITELN(CHR(179),' [E]xit                                    ',CHR(179));
  1209.    WRITELN(CHR(179),' [?] Help                                  ',CHR(179));
  1210.    ASCII_LINE(1, 192, 196, 43, 217);
  1211.    WRITELN;
  1212.    WRITELN;
  1213.    {Asks the user to press a desired key, to be stored in CHOICE}
  1214.    CHOICE := READKEY;
  1215.    {Keeps CHOICE an uppercase character}
  1216.    CHOICE := UPCASE(CHOICE);
  1217.    {Runs the respective procedure, depending on the value of CHOICE}
  1218.    CASE CHOICE OF
  1219.       'P'  : PRINT_THE_REPORT;
  1220.       'C'  : CHANGE_RANGE;
  1221.       'Q'  : MAIN_MENU;
  1222.       'E'  : QUIT;
  1223.       '?'  : HELP_SCREEN(PRINT_MENU_HELP, 'R');
  1224.    ELSE PRINT_REPORT;
  1225.    END;  {CASE}
  1226.  
  1227. END;   {PRINT_REPORT}
  1228.  
  1229. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1230.  
  1231. {This procedure produces the configuration menu}
  1232. PROCEDURE CONFIGURATION;
  1233.  
  1234. BEGIN;  {CONFIGURATION}
  1235.  
  1236.    {Clears the screen}
  1237.    CLRSCR;
  1238.    {Prints registration information}
  1239.    REGISTRATION_SCREEN;
  1240.    {Opens CONFIG for reading}
  1241.    RESET(CONFIG);
  1242.    {Simply prints the menu itself}
  1243.    WRITELN;
  1244.    ASCII_LINE(1, 0, 255, 14, 0);
  1245.    WRITELN(CHR(240),' CONFIGURATION ',CHR(240));
  1246.    WRITELN;
  1247.    ASCII_LINE(1, 218, 196, 43, 191);
  1248.    {Chooses value of Yes/No string depending on integer values}
  1249.    CASE LABEL_PREF OF
  1250.        1 : LABELS := 'Yes';
  1251.        0 : LABELS := 'No';
  1252.    END;  {CASE}
  1253.  
  1254.    CASE ASCII_PREF OF
  1255.        1 : ASCII := 'Yes';
  1256.        0 : ASCII := 'No';
  1257.    END;  {CASE}
  1258.  
  1259.    {Draws the menu}
  1260.    WRITELN;
  1261.    WRITELN(CHR(179),' Current settings:                         ',CHR(179));
  1262.    WRITELN(CHR(179),'   Registration name: ',REG_NAME:15 ,'      ',CHR(179));
  1263.    WRITELN(CHR(179),'   Database name: ',DB_NAME:20,'     ',CHR(179));
  1264.    WRITELN(CHR(179),'   ASCII printing: ',ASCII:3,'                     ',CHR(179));
  1265.    WRITELN(CHR(179),'   Print labels: ',LABELS:4,'                      ',CHR(179));
  1266.    WRITELN(CHR(179),' [C]hange this configuration               ',CHR(179));
  1267.    WRITELN(CHR(179),' [M]odify field names                      ',CHR(179));
  1268.    WRITELN(CHR(179),' [E]xit program                            ',CHR(179));
  1269.    WRITELN(CHR(179),' [Q]uit to main menu                       ',CHR(179));
  1270.    WRITELN(CHR(179),' [?] Help                                  ',CHR(179));
  1271.    ASCII_LINE(1, 192, 196, 43, 217);
  1272.    {Closes CONFIG}
  1273.    CLOSE(CONFIG);
  1274.    WRITELN;
  1275.    WRITELN;
  1276.    {Reads CHOICE as a key}
  1277.    CHOICE := READKEY;
  1278.    {Sets CHOICE to uppercase}
  1279.    CHOICE := UPCASE(CHOICE);
  1280.    {Acts upon the value of CHOICE}
  1281.    CASE CHOICE OF
  1282.       'C' : CHANGE_CONFIGURATION;
  1283.       'M' : MODIFY_FIELD_NAMES;
  1284.       'Q' : MAIN_MENU;
  1285.       'E' : QUIT;
  1286.       '?' : HELP_SCREEN(CONFIG_HELP, 'C');
  1287.    {If the value of CHOICE is not one of the above,
  1288.    the config menu is redrawn}
  1289.    ELSE CONFIGURATION;
  1290.    END;  {CASE statement}
  1291.  
  1292. END;  {CONFIGURATION}
  1293.  
  1294. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1295.  
  1296. {This procedure produces the main program menu}
  1297. PROCEDURE MAIN_MENU;
  1298.  
  1299. BEGIN;  {MAIN_MENU}
  1300.  
  1301. {Clears the screen}
  1302.    CLRSCR;
  1303.    {Runs REGISTRATION SCREEN}
  1304.    REGISTRATION_SCREEN;
  1305.    {These next few lines draw the menu itself}
  1306.    ASSIGN(DB, DATABASE_FILE_NAME);
  1307.    WRITELN;
  1308.    ASCII_LINE(1, 0, 255, 16, 0);
  1309.    WRITELN(CHR(240),' MAIN MENU ',CHR(240));
  1310.    WRITELN;
  1311.    ASCII_LINE(1, 218, 196, 43, 191);
  1312.    WRITELN;
  1313.    WRITELN(CHR(179),' [A]dd records                             ',CHR(179));
  1314.    WRITELN(CHR(179),' [P]rint report                            ',CHR(179));
  1315.    WRITELN(CHR(179),' [C]onfiguration                           ',CHR(179));
  1316.    WRITELN(CHR(179),' [E]xit                                    ',CHR(179));
  1317.    WRITELN(CHR(179),' [?] Help                                  ',CHR(179));
  1318.    ASCII_LINE(1, 192, 196, 43, 217);
  1319.    WRITELN;
  1320.    WRITELN;
  1321.    {Asks the user to press a desired key, to be stored in CHOICE}
  1322.    CHOICE := READKEY;
  1323.    {Keeps CHOICE an uppercase character}
  1324.    CHOICE := UPCASE(CHOICE);
  1325.    {Runs the respective procedure, depending on the value of CHOICE}
  1326.    CASE CHOICE OF
  1327.       'A'           : ADD_RECORDS;
  1328.       'P'           : CASE LABEL_PREF OF
  1329.                       1 : PRINT_LABELS;
  1330.                       0 : PRINT_REPORT;
  1331.                       END;
  1332.       'C'           : CONFIGURATION;
  1333.       'E', 'Q', 'X'     : QUIT;
  1334.       '?'           : HELP_SCREEN(MAIN_MENU_HELP, 'M');
  1335.    ELSE MAIN_MENU;
  1336.    END;  {CASE statement}
  1337.  
  1338. END; {MAIN_MENU}
  1339.  
  1340. {**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**//**}
  1341.  
  1342. {The main calling program begins here}
  1343. BEGIN;  {SOFTWARE_DATABASE}
  1344.  
  1345. {Prints welcoming information}
  1346. WELCOME;
  1347. {Sets variable EXIT to an inital value of 1 so that the program will run}
  1348. EXIT := 1;
  1349.  
  1350. {If EXIT ever does NOT equal 1, the program will stop}
  1351. WHILE EXIT = 1 DO
  1352.  
  1353. BEGIN;  {WHILE-DO loop}
  1354.  
  1355.    {Loads the main menu}
  1356.    MAIN_MENU;
  1357.  
  1358. END;  {WHILE_DO loop}
  1359.  
  1360. {Clears the screen}
  1361. CLRSCR;
  1362. {Prints ending remark}
  1363. WRITELN('SOFTWARE DATABASE by Brian Inderwies');
  1364.  
  1365. END.  {SOFTWARE_DATABASE}
  1366.  
  1367. { Nonstandard Pascal devices used in this program:         }
  1368. { (that is, they are not included in standard Pascal)      }
  1369. {    CLRSCR - clears the screen                            }
  1370. {    UPCASE - converts CHAR variables to uppercase         }
  1371. {    READKEY - reads an immediate character from the       }
  1372. {              keyboard                                    }
  1373. {    FORWARD - declares a procedure before it              }
  1374. {              actually appears                            }